home *** CD-ROM | disk | FTP | other *** search
/ Shareware Overload Trio 2 / Shareware Overload Trio Volume 2 (Chestnut CD-ROM).ISO / dir40 / pc37042.zip / UTIL / T370.ALC < prev   
Text File  |  1988-01-03  |  28KB  |  954 lines
  1.     TITLE 'T370  - CONVERT A370 OBJ FILE TO 370 OBJECT FORMAT'
  2. *
  3. * PGM-ID.  T370.ALC
  4. * AUTHOR.  DON HIGGINS.
  5. * DATE.    08/13/87.
  6. * REMARKS. THIS PROGRAM READS OBJ FILE CREATED BY A370 AND
  7. *          CREATES 370 RELOCATABLE OBJECT DECK FILE.
  8. * MAINTENANCE.
  9. *
  10. * 08/16/87 COMPLETE INITIAL CODING.
  11. * 08/19/87 COMPLETE INITAL DEBUGGING AND DOCUMENTATION REL 1.0
  12. * 01/03/88 USE STD. OS PARM REL 1.1
  13. *
  14. *
  15. *
  16. * PARMS.   T370  FILE/LCP
  17. *
  18. *          FILE IS NAME OF FILE OF THE TYPE FILE.OBJ.
  19. *          OUTPUT OF T370 IS FILE OF THE TYPE FILE.370.
  20. *          THE OPTIONAL PARMS ARE AS FOLLOWS:
  21. *
  22. *            L - LIST FORMATTED HEX OBJECT RECORDS IN FILE.HEX (DEFAULT OFF).
  23. *            C - LIST FORMATTED HEX OBJECT RECORDS ON CONSOLE  (DEFAULT OFF).
  24. *            P - OUTPUT 370 EBCDIC OBJECT RECORDS TO FILE.370. (DEFAULT ON).
  25. *
  26. *          CODING P ON PARM, TURNS 370 OUTPUT FILE OFF.
  27. *
  28. *          THE FORMAT OF THE OBJECT RECORDS IS AS FOLLOWS:
  29. *
  30. *            TYPE  COLUMN  DESCRIPTION
  31. *
  32. *            ESD    01-01   X'02'  EXTERNAL SYMBOL DICTIONARY ID
  33. *                   02-04   C'ESD'
  34. *                   05-10   BLANK
  35. *                   11-12   NUMBER OF BYTES OF ESD DATA
  36. *                   13-14   BLANK
  37. *                   15-16   ESD IDENTIFIER OF FIRST ITEM OR BLANK FOR LD
  38. *                   17-72   ESD ENTRIES (UP TO 3) AS FOLLOWS:
  39. *                            01-08 NAME OF SD, LD, ER
  40. *                            09-09 TYPE (HEX)
  41. *                                   00 - SD
  42. *                                   01 - LD
  43. *                                   02 - ER
  44. *                            10-12 23 BIT ADDRESS (SD,PC,LD)
  45. *                            13-13 ALIGNMENT FACTOR (HEX)
  46. *                                   07 - DOUBLEWORD
  47. *                                   03 - WORD ALIGNMENT
  48. *                                   01 - HALF WORD
  49. *                                   00 - BYTE ALIGNMENT
  50. *                            14-16 ZERO IF LENGTH ON END RECORD
  51. *                                  LENGTH OF CONTROL SECTION
  52. *                                  IDENTIFIER OF SD CONTAINING NAME
  53. *                                  BLANK IF ER
  54. *                   73-80   RECORD SEQUENCE FIELD NOT USED BY LINKERS
  55. *
  56. *            TXT    01-01   X'02'
  57. *                   02-04   C'TXT'
  58. *                   05-05   BLANK
  59. *                   06-08   24 BIT ADDRESS OF FIRST BYTE OF TEXT
  60. *                   09-10   BLANK
  61. *                   11-12   NUMBER OF BYTES OF TEXT
  62. *                   13-14   BLANK
  63. *                   15-16   ESD IDENTIFIER OF SD CONTAINING THIS TEXT
  64. *                   17-72   TEXT DATA
  65. *                   73-80   RECORD SEQUENCE FIELD NOT USED BY LINKERS
  66. *
  67. *            RLD    01-01   X'02'
  68. *                   02-04   C'RLD'
  69. *                   05-10   BLANK
  70. *                   11-12   NUMBER OF BYTES OF RLD DATA
  71. *                   13-16   BLANK
  72. *                   17-72   RLD DATA ENTRIES AS FOLLOWS:
  73. *                            01-02 ESDID OF CESD ENTRY FOR SYMBOL BEING DEFINED
  74. *                            03-04 ESDID OF SD CONTAINING ADDRESS CONSTANT
  75. *                            05-05 FLAG FIELD (TTTTLLST)
  76. *
  77. *                                  TTTT - 0000 NONBRANCH
  78. *                                         0001 BRANCH
  79. *                                         0011 PSEUDO REGISTER
  80. *                                    LL - 01   TWO BYTES
  81. *                                         10   THREE BYTES
  82. *                                         11   FOUR BYTES
  83. *                                     S - 0    POSITIVE RELOCATION
  84. *                                         1    NEGATIVE RELOCATION
  85. *                                     T - 0    NEXT RLD ENTRY HAS POINTERS
  86. *                                         1    NEXT RLD HAS SAME POINTERS
  87. *                                              (BYTES 01-04 OMITTED FOR NEXT)
  88. *
  89. *                   73-80   RECORD SEQUENCE FIELD NOT USED BY LINKERS
  90. *
  91. *            END    01-01   X'02'
  92. *                   02-04   C'END'
  93. *                   05-05   BLANK
  94. *                   06-08   24 BIT ADDRESS OF ENTRY POINT (OPTIONAL)
  95. *                   09-14   BLANK
  96. *                   15-16   ESDID OF SD CONTAINING ENTRY
  97. *                   17-28   BLANK
  98. *                   29-32   CONTROL SECTION LENGTH IF NOT IN SD
  99. *                           (29=X'00' IF PRESENT)
  100. *                   33-72   BLANK
  101. *                   73-80   RECORD SEQUENCE FIELD NOT USED
  102. *
  103. *          THE INPUT FILE FORMAT IS AN EXTENSION OF MICROSOFT
  104. *          M80 MACRO ASSEMBLER RELOCATABLE BIT STREAM FILE.
  105. *
  106. *          FOR EXAMPLE, RUN BAT\RUNUTIL.BAT.
  107. *
  108. T370     CSECT
  109.     LR    R12,R15
  110.     LA    R13,2048(R12)
  111.     LA    R13,2048(R13)
  112.     USING T370,R12
  113.     USING T370+4096,R13
  114.     LA    R2,=C'T370.COM R1.1 - CONVERT PC/370 OBJ FILE TO 370 FILE$'
  115.     SVC   WTO
  116.     BAL   R14,INIT   GET PARMS AND INITIALIZE FILES
  117.     BNZ   EOJ
  118.     SR    R6,R6      NO BITS
  119.     LA    R7,UT1RCD+L'UT1RCD  FORCE BUFFER RELOAD
  120.     LA    R8,4
  121.     LA    R9,UT1RCD+L'UT1RCD  END OF BUFFER FOR BXH
  122. LOOP     EQU   *
  123.     BAL   R14,GBIT   IF NEXT BIT 0, NEXT BYTE IS ABS TEXT
  124.     BNZ   NOTTXT
  125. TXTTYPE  EQU   *          GET NEXT ABS BYTE AND STORE IN TXT RECORD
  126.     BAL   R14,GBYTE
  127.     LM    R1,R3,TXTREGS
  128.     STC   R4,0(R1)   SAVE BYTE IN TEXT TABLE
  129.     LA    R1,1(R1)   INC TABLE POINTER
  130.     LA    R3,1(R3)   INC BYTE COUNT
  131.     STM   R1,R3,TXTREGS
  132.     CLR   R1,R2
  133.     BL    LOOP       IF TXT RECORD NOT FULL, CONTINUE
  134.     BAL   R14,PUTTXT
  135.     B     LOOP
  136. NOTTXT   EQU   *          GET NEXT TWO BITS TO FORM 3 BIT TYPE OF ENTRY
  137.     LR    R3,R4
  138.     SLL   R3,1
  139.     BAL   R14,GBIT
  140.     OR    R3,R4
  141.     SLL   R3,1
  142.     BAL   R14,GBIT
  143.     OR    R3,R4      R3 = THREE BIT TYPE
  144.     CLM   R3,1,=AL1(LNKTYP)
  145.     BE    LNKTYPE    IF LINK TYPE, GO PROCESS ESD, RLD, ETC.
  146. RELTYPE  EQU   *          ELSE 16 BIT RELOCATED WORD
  147.     LA    R2,=C'RELATIVE 16 BIT WORDS NOT ALLOWED IN 370 OBJ$'
  148.     SVC   WTO
  149.     B     EOJ
  150. LNKTYPE  EQU   *          BRANCH TO TYPE OF SPECIAL LINKAGE ENTRY
  151.     BAL   R14,GBIT   BASED ON NEXT 4 BIT TYPE CODE
  152.     LR    R3,R4
  153.     SLL   R3,1
  154.     BAL   R14,GBIT
  155.     OR    R3,R4
  156.     SLL   R3,1
  157.     BAL   R14,GBIT
  158.     OR    R3,R4
  159.     SLL   R3,1
  160.     BAL   R14,GBIT
  161.     OR    R3,R4      R3 = LINK TYPE
  162.     AR    R3,R3
  163.     AR    R3,R3
  164.     L     R4,LNKRTN(R3)  R4 = ADDRESS OF LINK ROUTINE LT0-LTF
  165.     BAL   R14,PUTTXT     FLUSH TXT BEFORE PROCESSING LINK TYPE
  166.     BR    R4             JUMP
  167. EOJ      EQU   *          END OF FILE AT PHYSICAL EOF OR ERROR
  168.     LA    R2,SYSUT1
  169.     SVC   CLOSE          CLOSE INPUT
  170.     CLI   OPTIONP,TRUE
  171.     BNE   SKPCLSP
  172.     LA    R2,SYSUT2
  173.     SVC   CLOSE          CLOSE 370 IF OPEN
  174. SKPCLSP  EQU   *
  175.     CLI   OPTIONL,TRUE
  176.     BNE   SKPCLSL
  177.     LA    R2,SYSPRINT
  178.     SVC   CLOSE          CLOSE HEX IF OPEN
  179. SKPCLSL  EQU   *
  180.     LA    R2,=C'T370 COMPLETE$'
  181.     SVC   WTO
  182.     SVC   EXIT
  183. INIT     EQU   *    GET FILE NAMES FROM PARM AND SET OPTIONS
  184.     L     R1,0(R1)
  185.     LH    R0,0(R1)
  186.     SH    R0,=H'1'
  187.     BNP   INITERR   NO FILE SPECIFIED
  188.     LA    R2,3(R1)  SKIP BLANK CHAR LEADING FILENAME
  189.     LR    R1,R0
  190.     LR    R3,R0     SAVE FOR INITFILE
  191. FINDSLSH EQU   *
  192.     CLI   0(R2),C'/'
  193.     BE    SETOPT
  194.     LA    R2,1(R2)
  195.     BCT   R1,FINDSLSH
  196. NOTFOUND EQU   *            NO OPTIONS SPECIFIED
  197.     LR    R1,R3
  198. INITFILE EQU   *            BUILD FILE NAMES WITH SUFFIXES
  199.     EX    R1,MVCUT1
  200.     EX    R1,MVCUT2
  201.     EX    R1,MVCPRT
  202.     LA    R2,UT1DSN(R1)
  203.     MVC   0(5,R2),UT1SFX
  204.     LA    R2,UT2DSN(R1)
  205.     MVC   0(5,R2),UT2SFX
  206.     LA    R2,PRTDSN(R1)
  207.     MVC   0(5,R2),PRTSFX
  208.     LA    R2,=C' $'
  209.     SVC   WTO
  210.     LA    R2,OPTLINE      DISPLAY OPTIONS SET
  211.     SVC   WTO
  212.     LA    R2,=C' $'
  213.     SVC   WTO
  214.     LA    R2,SYSUT1
  215.     SVC   SEARCH          ISSUE ERROR IF OBJ FILE NOT FOUND
  216.     CLM   R0,1,=X'00'
  217.     BNE   INITERR
  218.     LA    R2,SYSUT1
  219.     SVC   OPEN            OPEN OBJ INPUT
  220.     CLI   OPTIONP,TRUE
  221.     BNE   SKPOPNP
  222.     LA    R2,SYSUT2
  223.     SVC   OPEN            OPEN 370 OUTPUT
  224. SKPOPNP  EQU   *
  225.     CLI   OPTIONL,TRUE
  226.     BNE   SKPOPNL
  227.     LA    R2,SYSPRINT
  228.     SVC   OPEN            OPEN HEX OUTPUT
  229. SKPOPNL  EQU   *
  230.     SR    R0,R0
  231.     BR    R14
  232. INITERR  EQU   *
  233.     LA    R2,=C'INVALID FILE NAME$'
  234.     SVC   WTO
  235.     SVC   EXIT
  236. MVCUT1   MVC   UT1DSN(0),TBUFF+7
  237. MVCUT2   MVC   UT2DSN(0),TBUFF+7
  238. MVCPRT   MVC   PRTDSN(0),TBUFF+7
  239. SETOPT   EQU   *
  240.     LR    R0,R2
  241.     S     R0,=A(TBUFF+7) CALC LENGTH OF DSN
  242.     BZ    OPTERR    NO FILE SINCE / IS FIRST CHAR
  243.     LA    R2,1(R2)
  244.     BCT   R1,OPTLOOP
  245.     B     OPTERR
  246. OPTLOOP  EQU   *
  247.     CLI   0(R2),C'P'
  248.     BE    SETOPTP
  249.     CLI   0(R2),C'L'
  250.     BE    SETOPTL
  251.     CLI   0(R2),C'C'
  252.     BE    SETOPTC
  253. OPTERR   EQU   *
  254.     LA    R2,=C'INVALID PARM$'
  255.     SVC   WTO
  256.     SVC   EXIT
  257. SETOPTP  EQU   *
  258.     MVI   OPTIONP,FALSE TURN OFF OUTPUT OF 370 OBJECT FILE (.370)
  259.     MVI   DOPTP,C' '
  260. NEXTOP   EQU   *
  261.     LA    R2,1(R2)
  262.     BCT   R1,OPTLOOP
  263.     LR    R1,R0      PUT LENGTH OF DSN UP TO SLASH IN R1
  264.     MVC   OPTHEX,OPTIONL
  265.     OC    OPTHEX,OPTIONC SET HEX TRUE IF ANY HEX OUTPUT REQ'D
  266.     B     INITFILE
  267. SETOPTL  EQU   *
  268.     MVI   OPTIONL,TRUE  TURN ON HEX LISTING FILE (.HEX)
  269.     MVI   DOPTL,C'L'
  270.     B     NEXTOP
  271. SETOPTC  EQU   *
  272.     MVI   OPTIONC,TRUE  TURN ON OUTPUT OF HEX CONSOLE LISTING
  273.     MVI   DOPTC,C'C'
  274.     B     NEXTOP
  275. GBIT     EQU   *          GET NEXT BIT IN R4
  276.     SR    R4,R4
  277.     LTR   R6,R6
  278.     BNZ   GBITNOW
  279.     BAL   R10,GWORD  GET NEXT WORD IF NO BITS AVAIL.
  280. GBITNOW  EQU   *
  281.     SLDL  R4,1       MOVE NEXT BIT FROM R5 TO R4
  282.     BCTR  R6,0       DEC BIT COUNT IN R6
  283.     LTR   R4,R4      SET CC
  284.     BR    R14        EXIT
  285. GWORD    EQU   *          GET NEXT 32 BITS IN R5 AND RESET R6 BIT COUNT
  286.     L     R5,0(R7)   LOAD NEXT WORD
  287.     BXH   R7,R8,GREAD INCR R7 BY 4 AND CHECK IF WORD IN BLOCK
  288.     LA    R6,32      RELOAD BIT COUNTER
  289.     BR    R10        EXIT WITH NEXT WORD
  290. GREAD    EQU   *          GET NEXT 128 BYTE OBJ RECORD AND LOAD WORD
  291.     LA    R1,UT1RCD
  292.     LA    R2,SYSUT1
  293.     SVC   GET        READ NEXT BLOCK OR EXIT TO EOJ
  294.     LA    R7,UT1RCD  RESET RECORD PTR FOR GWORD BXH
  295.     B     GWORD
  296. GBYTE    EQU   *          GET NEXT BYTE IN R4
  297.     SR    R4,R4
  298.     LR    R1,R6      SAVE BIT COUNT
  299.     SH    R6,=H'8'   ARE THERE 8 BITS LEFT
  300.     BM    GSPLIT     NO, GET MISSING BITS FROM NEXT WORD
  301.     SLDL  R4,8       YES, SHIFT ALL 8
  302.     BR    R14        EXIT
  303. GSPLIT   EQU   *
  304.     SLDL  R4,0(R1)   SHIFT REMAINING BITS IN CURRENT WORD
  305.     LA    R11,8
  306.     SR    R11,R1     CALC REMAINING BITS TO SHIFT IN R11
  307.     BAL   R10,GWORD  GET NEXT WORD
  308.     SLDL  R4,0(R11)  SHIFT REST OF BYTE FROM NEW WORD
  309.     SR    R6,R11     DEC BIT COUNTER BY REMAINING BITS SHIFTED
  310.     BR    R14        EXIT
  311. LT0      EQU   *
  312. LT1      EQU   *
  313. LT2      EQU   *
  314. LT3      EQU   *
  315.     LA    R2,=C'INVALID LT0-LT3 RECORD TYPE$'
  316.     SVC   WTO
  317.     SVC   TRACE
  318.     DC    C'BUG '
  319.     B     *
  320. LT4      EQU   *          PROCESS EXTENDED TYPE 4 LINK ENTRY
  321.     BAL   R14,GBIT
  322.     BAL   R14,GBIT
  323.     BAL   R14,GBYTE
  324.     STC   R4,LT4TYP  ESD TYPE
  325.     BAL   R14,GBYTE
  326.     STC   R4,LT4EID  ESD EID
  327.     CLI   LT4TYP,ESDER
  328.     BE    LT4B       GO GET SYMBOL FOR ER
  329.     BAL   R14,GBYTE
  330.     STC   R4,ADDR+3
  331.     BAL   R14,GBYTE
  332.     STC   R4,ADDR+2
  333.     BAL   R14,GBYTE
  334.     STC   R4,ADDR+1
  335.     BAL   R14,GBYTE
  336.     STC   R4,ADDR+0  ESD ADDRESS
  337.     CLI   LT4TYP,ESDSD
  338.     BNE   CHKTYP
  339.     BAL   R14,GBYTE
  340.     STC   R4,SDLNG+3
  341.     BAL   R14,GBYTE
  342.     STC   R4,SDLNG+2
  343.     BAL   R14,GBYTE
  344.     STC   R4,SDLNG+1
  345.     BAL   R14,GBYTE
  346.     STC   R4,SDLNG+0  ESD LENGTH
  347.     B     LT4B        GO GET SYMBOL FOR SD
  348. CHKTYP   EQU   *
  349.     CLI   LT4TYP,ESDLD
  350.     BE    LT4B        GO GET SYMBOL FOR LD
  351.     CLI   LT4TYP,ESDORG
  352.     BE    LT4ORG
  353.     CLI   LT4TYP,ESDEND
  354.     BE    LT4END
  355.     SR    R0,R0
  356.     IC    R0,LT4TYP
  357.     N     R0,=X'0000000F'
  358.     CLM   R0,1,=AL1(ESDRLD)
  359.     BE    LT4RLD
  360. LT4ERR   EQU   *
  361.     LA    R2,=C'INVALID TYPE 4 LINK RECORD$'
  362.     SVC   WTO
  363.     SVC   TRACE
  364.     DC    C'BUG '
  365.     B     *
  366. LT4B     EQU   *         GET SYMBOL FOR SD, LD, OR ER
  367.     BAL   R14,GBIT
  368.     LR    R3,R4
  369.     BAL   R14,GBIT
  370.     SLL   R3,1
  371.     OR    R3,R4
  372.     BAL   R14,GBIT
  373.     SLL   R3,1
  374.     OR    R3,R4      R3 = LENGTH OF SYMBOL
  375.     MVC   SYMBOL,=8AL1(ASCBLK)
  376.     MVC   ASYMBOL,=A(SYMBOL)
  377.     CH    R3,=H'7'
  378.     BH    GBERR
  379.     LTR   R3,R3
  380.     BP    LT4LP
  381.     LA    R3,8       ZERO LENGTH MEANS 8 BYTE SYMBOL
  382. LT4LP    EQU   *
  383.     BAL   R14,GBYTE
  384.     L     R1,ASYMBOL
  385.     STC   R4,0(R1)
  386.     LA    R1,1(R1)
  387.     ST    R1,ASYMBOL
  388.     BCT   R3,LT4LP
  389.     LA    R1,SYMBOL
  390.     LA    R2,8
  391.     SVC   ASCEBC     CONVERT SYMBOL TO EBCDIC
  392.     CLI   LT4TYP,ESDSD
  393.     BE    LT4SD
  394.     CLI   LT4TYP,ESDER
  395.     BE    LT4ER
  396.     CLI   LT4TYP,ESDLD
  397.     BE    LT4LD
  398.     B     LT4ERR
  399. GBERR    EQU   *
  400.     LA    R2,=C'INVALID SYMBOL LENGTH FOR LT4$'
  401.     SVC   WTO
  402.     SVC   TRACE
  403.     DC    C'BUG '
  404.     B     *
  405. LT4SD    EQU   *      PROCESS SD ENTRY
  406.     SR    R0,R0
  407.     IC    R0,LT4EID
  408.     STCM  R0,3,ESDEID
  409.     MVC   ESDCNT,=H'16'
  410.     MVC   ESDBUF(8),SYMBOL
  411.     MVI   ESDBUF+8,X'00'     SD TYPE
  412.     MVC   ESDBUF+9(3),ADDR+1
  413.     MVI   ESDBUF+12,X'03'    AMODE=ANY (01=24 BIT, 00=31 BIT)
  414.     MVC   ESDBUF+13(3),SDLNG+1
  415.     LA    R1,ESDRCD
  416.     BAL   R10,PUTOBJ         OUTPUT 370 RECORD
  417.     CLI   OPTHEX,TRUE        CHECK IF ANY HEX OUTPUT REQ'D
  418.     BNE   SKPSDL             NO, SKIP FORMATTING
  419.     SR    R0,R0
  420.     IC    R0,LT4EID
  421.     BAL   R14,CVTHEX
  422.     MVC   ESDDEID,HEX+6
  423.     MVC   ESDDSYM,SYMBOL
  424.     L     R0,ADDR
  425.     BAL   R14,CVTHEX
  426.     MVC   ESDDADDR,HEX+2
  427.     L     R0,SDLNG
  428.     BAL   R14,CVTHEX
  429.     MVC   ESDDLNG,HEX+2
  430.     MVC   ESDDTYP,=C'SD'
  431.     LA    R1,ESDLINE
  432.     BAL   R10,PUTPRT
  433. SKPSDL   EQU   *
  434.     B     LOOP
  435. LT4ER    EQU   *      PROCESS ER ENTRY
  436.     SR    R0,R0
  437.     IC    R0,LT4EID
  438.     STCM  R0,3,ESDEID
  439.     MVC   ESDCNT,=H'16'
  440.     MVC   ESDBUF(8),SYMBOL
  441.     MVI   ESDBUF+8,X'02'     ER TYPE
  442.     MVC   ESDBUF+9(7),=7C' '
  443.     LA    R1,ESDRCD
  444.     BAL   R10,PUTOBJ
  445.     CLI   OPTHEX,TRUE
  446.     BNE   SKPERL
  447.     SR    R0,R0
  448.     IC    R0,LT4EID
  449.     BAL   R14,CVTHEX
  450.     MVC   ESDDEID,HEX+6
  451.     MVC   ESDDSYM,SYMBOL
  452.     MVC   ESDDADDR,=6C' '
  453.     MVC   ESDDLNG,=6C' '
  454.     MVC   ESDDTYP,=C'ER'
  455.     LA    R1,ESDLINE
  456.     BAL   R10,PUTPRT
  457. SKPERL   EQU   *
  458.     B     LOOP
  459. LT4LD    EQU   *      PROCESS LD ENTRY
  460.     MVC   ESDEID,=2C' '     BLANK ESD EID FOR LD
  461.     MVC   ESDCNT,=H'16'
  462.     MVC   ESDBUF(8),SYMBOL
  463.     MVI   ESDBUF+8,X'01'     LD TYPE
  464.     MVC   ESDBUF+9(3),ADDR+1
  465.     MVI   ESDBUF+12,C' '
  466.     SR    R0,R0
  467.     IC    R0,LT4EID
  468.     STCM  R0,7,ESDBUF+13     EID FOR LD
  469.     LA    R1,ESDRCD
  470.     BAL   R10,PUTOBJ
  471.     CLI   OPTHEX,TRUE
  472.     BNE   SKPLDL
  473.     SR    R0,R0
  474.     IC    R0,LT4EID
  475.     BAL   R14,CVTHEX
  476.     MVC   ESDDEID,HEX+6
  477.     MVC   ESDDSYM,SYMBOL
  478.     L     R0,ADDR
  479.     BAL   R14,CVTHEX
  480.     MVC   ESDDADDR,HEX+2
  481.     MVC   ESDDLNG,=6C' '
  482.     MVC   ESDDTYP,=C'LD'
  483.     LA    R1,ESDLINE
  484.     BAL   R10,PUTPRT
  485. SKPLDL   EQU   *
  486.     B     LOOP
  487. LT4RLD   EQU   *     PROCESS RLD ENTRY
  488.     BAL   R14,GBYTE
  489.     STC   R4,RLDEID   RLD EID
  490.     MVC   RLDCNT,=H'8'
  491.     SR    R0,R0
  492.     IC    R0,RLDEID
  493.     STCM  R0,3,RLDBUF+2      EID FOR SD WITH RLD
  494.     IC    R0,LT4EID
  495.     STCM  R0,3,RLDBUF+0      EID FOR SYMBOL
  496.     IC    R0,LT4TYP          R0 = SLLLTTTT (SIGN, RLD LNG, RLD TYPE)
  497.     LR    R1,R0              SAVE SIGN BIT IN R1
  498.     N     R0,=X'00000070'    R0 = 0LLL0000 WHERE LLL = 2-4
  499.     SH    R0,=H'16'          R0 = 00NN0000 WHERE NNN = 1-3
  500.     SRL   R0,2               R0 = 0000NN00
  501.     N     R1,=X'00000080'    R1 = S0000000
  502.     SRL   R1,6               R1 = 000000S0
  503.     OR    R0,R1              R0 = 0000NNS0
  504.     STC   R0,RLDBUF+4        RLD LNG (01=2, 02=3, 3=4) PLUS SIGN
  505.     MVC   RLDBUF+5(3),ADDR+1
  506.     LA    R1,RLDRCD
  507.     BAL   R10,PUTOBJ
  508.     CLI   OPTHEX,TRUE
  509.     BNE   SKPRLDL
  510.     SR    R0,R0
  511.     IC    R0,LT4EID
  512.     BAL   R14,CVTHEX
  513.     MVC   RLDDEID,HEX+6   EID OF SYMBOL REFERENCED
  514.     SR    R0,R0
  515.     IC    R0,RLDEID
  516.     BAL   R14,CVTHEX
  517.     MVC   RLDDSID,HEX+6   EID OF CONTROL SECTION WITH RLD
  518.     SR    R0,R0
  519.     IC    R0,RLDBUF+4     USE FORMATTED TTTTLLS0 TO GET LNG AND SIGN
  520.     SRL   R0,2
  521.     AH    R0,=H'1'
  522.     BAL   R14,CVTHEX
  523.     MVC   RLDDLNG,HEX+6
  524.     IC    R0,RLDBUF+4
  525.     N     R0,=X'00000002'
  526.     BZ    LT4RSP
  527.     MVI   RLDDSGN,C'-'
  528.     B     LT4RSC
  529. LT4RSP   EQU   *
  530.     MVI   RLDDSGN,C'+'
  531. LT4RSC   EQU   *
  532.     L     R0,ADDR
  533.     BAL   R14,CVTHEX
  534.     MVC   RLDDADDR,HEX+2
  535.     LA    R1,RLDLINE
  536.     BAL   R10,PUTPRT
  537. SKPRLDL  EQU   *
  538.     B     LOOP
  539. LT4ORG   EQU   *        PROCESS ORG ENTRY WHICH RESETS TXT EID AND ADDRESS
  540.     SR    R0,R0
  541.     IC    R0,LT4EID
  542.     STCM  R0,3,TXTEID     SET TXT EID
  543.     MVC   TXTADDR,ADDR+1  SET TXT ADDR
  544.     B     LOOP
  545. LT4END   EQU   *        PROCESS END ENTRY
  546.     LR    R7,R9    FORCE END OF RECORD
  547.     SR    R6,R6    FORCE NO BITS
  548.     SR    R0,R0
  549.     IC    R0,LT4EID
  550.     STCM  R0,3,ENDEID  EID FOR ENTRY ADDRESS
  551.     MVC   ENDADDR,ADDR+1
  552.     LA    R1,ENDRCD
  553.     BAL   R10,PUTOBJ
  554.     CLI   OPTHEX,TRUE
  555.     BNE   SKPENDL
  556.     SR    R0,R0
  557.     IC    R0,LT4EID
  558.     BAL   R14,CVTHEX
  559.     MVC   ENDDEID,HEX+6
  560.     L     R0,ADDR
  561.     BAL   R14,CVTHEX
  562.     MVC   ENDDADDR,HEX+2
  563.     LA    R1,ENDLINE
  564.     BAL   R10,PUTPRT
  565. SKPENDL  EQU   *
  566.     B     LOOP
  567. LT5      EQU   *
  568. LT6      EQU   *
  569. LT7      EQU   *
  570. LT8      EQU   *
  571. LT9      EQU   *
  572. LTA      EQU   *
  573. LTB      EQU   *
  574. LTC      EQU   *
  575. LTD      EQU   *
  576. LTE      EQU   *
  577. LTF      EQU   *
  578.     LA    R2,=C'INVALID LT5-LTF RECORD TYPE$'
  579.     SVC   WTO
  580.     SVC   TRACE
  581.     DC    C'BUG '
  582.     B     *
  583. PUTTXT   EQU   *          FLUSH CURRENT TXT RCD IF ANY
  584.     LM    R1,R3,TXTREGS
  585.     LTR   R3,R3
  586.     BZ    0(R14)        EXIT IF NO TEXT
  587.     ST    R14,TXTSAV
  588.     L     R1,ADDR       FORMAT ADDRESS
  589.     STCM  R1,7,TXTADDR
  590.     SR    R1,R1
  591.     IC    R1,LT4EID     FORMAT EID
  592.     STCM  R1,3,TXTEID
  593.     IC    R1,TXTREGS+11 FORMAT BYTE COUNT
  594.     STCM  R1,3,TXTCNT
  595.     LA    R0,55
  596.     SR    R0,R1         R0 = PAD BLKS - 1
  597.     BM    SKPTPAD
  598.     LA    R2,TXTBUF(R1)
  599.     LR    R1,R0
  600.     EX    R1,MVCTPAD
  601. SKPTPAD  EQU   *
  602.     LA    R1,TXTRCD
  603.     BAL   R10,PUTOBJ
  604.     CLI   OPTHEX,TRUE
  605.     BNE   TXTEXT
  606.     L     R0,ADDR       FORMAT TEXT ADDRESS
  607.     BAL   R14,CVTHEX
  608.     MVC   TXTDADDR,HEX+2
  609.     IC    R0,LT4EID     FORMAT CNT AND EID
  610.     ICM   R0,2,TXTREGS+11
  611.     BAL   R14,CVTHEX
  612.     MVC   TXTDCNT,HEX+4
  613.     MVC   TXTDEID,HEX+6
  614.     L     R11,TXTREGS+8 REMAINING BYTE COUNT 1-56
  615.     LA    R1,TXTBUF     TEXT POINTER
  616.     BAL   R14,FMTTXT    PRINT FIRST LINE WITH 16 BYTES
  617.     SH    R11,=H'16'
  618.     BNP   TXTEXT
  619.     MVC   TXTDBLK,=CL13' '  BLANK TXT ADDR,CNT,EID FOR MULT. LINES
  620.     LA    R1,TXTBUF+16
  621.     BAL   R14,FMTTXT    2ND
  622.     SH    R11,=H'16'
  623.     BNP   TXTEXT
  624.     MVC   TXTDBLK,=CL13' '  BLANK TXT ADDR,CNT,EID FOR MULT. LINES
  625.     LA    R1,TXTBUF+32
  626.     BAL   R14,FMTTXT    3RD
  627.     SH    R11,=H'16'
  628.     BNP   TXTEXT
  629.     MVC   TXTDBLK,=CL13' '  BLANK TXT ADDR,CNT,EID FOR MULT. LINES
  630.     LA    R1,TXTBUF+48
  631.     BAL   R14,FMTTXT    4TH
  632. TXTEXT   EQU   *
  633.     L     R0,ADDR
  634.     A     R0,TXTREGS+8 INCR TXT ADDR BY LENGTH
  635.     ST    R0,ADDR
  636.     MVC   TXTREGS(12),=A(TXTBUF,TXTBUF+L'TXTBUF,0) RESET REGS
  637.     L     R14,TXTSAV
  638.     BR    R14
  639. FMTTXT   EQU   *             FORMAT TEXT AT R1 FOR LENGTH (R3)
  640.     ST    R14,FMTSAV
  641.     MVC   TXTDASC,0(R1)
  642.     TR    TXTDASC,PRTASC
  643.     LA    R2,TXTDHEX
  644.     LA    R3,4
  645. FMTL1    EQU   *
  646.     L     R0,0(R1)
  647.     BAL   R14,CVTHEX
  648.     MVC   0(8,R2),HEX
  649.     LA    R1,4(R1)
  650.     LA    R2,8(R2)
  651.     BCT   R3,FMTL1
  652.     CL    R11,=F'16'
  653.     BNL   FMTSKP
  654.     LR    R1,R11
  655.     AR    R1,R1
  656.     LA    R2,TXTDHEX(R1)
  657.     LA    R0,31
  658.     SR    R0,R1
  659.     LR    R1,R0
  660.     EX    R1,MVCTPAD PAD HEX WITH BLANKS
  661.     LA    R1,15
  662.     SR    R1,R11
  663.     LA    R2,TXTDASC(R11)
  664.     EX    R1,MVCTPAD PAD ASC WITH BLANKS
  665. FMTSKP   EQU   *
  666.     LA    R1,TXTLINE
  667.     BAL   R10,PUTPRT
  668.     L     R14,FMTSAV
  669.     BR    R14
  670. MVCTPAD  MVC   0(0,R2),=56C' '
  671. CVTHEX   EQU   *   CONVERT R0 TO H8 BYTE EBCDIC HEX
  672.     ST    R0,WORK
  673.     UNPK  HEX(9),WORK(5)
  674.     TR    HEX(8),HEXTAB-240
  675.     BR    R14
  676. PUTOBJ   EQU   *   OUTPUT SEQUENCED 370 OBJECT DECK FILE
  677.     AP    PSEQ,=P'1'
  678.     UNPK  72(8,R1),PSEQ
  679.     OI    79(R1),X'F0'
  680.     CLI   OPTIONP,TRUE
  681.     BNER  R10
  682.     LA    R2,SYSUT2
  683.     SVC   PUT    OUTPUT 370 OBJECT FILE FOR OPTION P
  684.     BR    R10
  685. PUTPRT   EQU   *  OUTPUT SEQUENCED ASCII HEX LISTING FILE
  686.     MVC   0(6,R1),=X'402020202020' MASK FOR ZZZZZ
  687.     ED    0(6,R1),PSEQ+1
  688.     CLI   OPTIONC,TRUE
  689.     BNE   SKPOPTC
  690.     LR    R2,R1
  691.     SVC   WTO   LIST HEX ON CONSOLE FOR OPTION C
  692. SKPOPTC  EQU   *
  693.     CLI   OPTIONL,TRUE
  694.     BNER  R10
  695.     LA    R2,SYSPRINT
  696.     SVC   PUT   OUTPUT HEX FILE FOR OPTION L
  697.     BR    R10
  698. *
  699. * REGISTER USAGE
  700. *
  701. R0       EQU   0  WORK
  702. R1       EQU   1  WORK
  703. R2       EQU   2  WORK
  704. R3       EQU   3  WORK (NOT USED BY LOW LEVEL BAL RTNS)
  705. R4       EQU   4  BIT OR BYTE RETURNED BY GBIT OR GBYTE  (R4-R5 SLDL)
  706. R5       EQU   5  CURRENT WORD
  707. R6       EQU   6  BITS LEFT IN CURRENT WORD
  708. R7       EQU   7  ADDRESS OF NEXT WORD PTR IN UT1RCD     (R7-R9 BXLE)
  709. R8       EQU   8  INCREMENT 4
  710. R9       EQU   9  ADDRESS OF END OF UT1RCD
  711. R10      EQU   10 LINK FOR LEVEL 2 ROUTINES
  712. R11      EQU   11 WORK (NOT USED BY LOW LEVEL BAL RTNS)
  713. R12      EQU   12 BASE
  714. R13      EQU   13 BASE
  715. R14      EQU   14 LINK FOR LEVEL 1 ROUTINES
  716. R15      EQU   15 WORK
  717. *
  718. * PC/370 SVC'S
  719. *
  720. EXIT     EQU   0
  721. OPEN     EQU   1
  722. CLOSE    EQU   2
  723. GET      EQU   5
  724. PUT      EQU   6
  725. SEARCH   EQU   8
  726. TRACE    EQU   9
  727. GMAIN    EQU   10
  728. FMAIN    EQU   11
  729. ASCEBC   EQU   12
  730. EBCASC   EQU   13
  731. WTO      EQU   200+9  MS-DOS SVC 9 PRINT STRING WITH ENDING $ ON CON.
  732. *
  733. * DATA AREAS
  734. *
  735. PSEQ     DC    PL4'0'
  736. WORK     DC    F'0',X'0'
  737. HEX      DC    XL8'0',X'0'
  738. HEXTAB   DC    C'0123456789ABCDEF'
  739. TBUFF    EQU   X'80'  BUFFER FOR DIRECTORY SEARCH
  740. UT1RCD   DC    XL128'00'   LOGICAL RECORD AREA
  741. UT2RCD   DC    CL80' '
  742. PRTLINE  DC    CL133' '
  743.     DS    CL2     PAD FOR ENDING CR,LF
  744. ASCBLK   EQU   X'20'   ASCII BLANK
  745. ASCLF    EQU   X'0A'   ASCII LINE FEED
  746. ASCCR    EQU   X'0D'   ASCII CARRIAGE RETURN
  747. CR       EQU   X'0D'   EBCDIC CARRIAGE RETURN
  748. LF       EQU   X'25'   EBCDIC LINE FEED
  749. LNKTYP   EQU   X'04'   EXTENDED TYPE 4 LINK RECORD USED BY A370
  750. LNKRTN   DC    A(LT0,LT1,LT2,LT3,LT4,LT5,LT6,LT7,LT8)  LINK TYPE RTNS
  751.     DC    A(LT9,LTA,LTB,LTC,LTD,LTE,LTF)
  752. OPTIONP  DC    AL1(TRUE)    DEFAULT P ON
  753. OPTIONC  DC    AL1(FALSE)   DEFAULT C OFF
  754. OPTIONL  DC    AL1(FALSE)   DEFAULT L OFF
  755. OPTHEX   DC    AL1(FALSE)   SUM OF C AND L TO DETERMINE IF HEX NEEDED
  756. TRUE     EQU   1
  757. FALSE    EQU   0
  758. OPTLINE  DC    C'T370 OPTIONS = '
  759. DOPTP    DC    C'P'         DEFAULT P ON FOR 370 OBJECT FILE
  760. DOPTC    DC    C' '         DEFAULT C OFF FOR NO CONSOLE HEX LISTING
  761. DOPTL    DC    C' ',C'$'    DEFAULT L OFF FOR NO HEX LISTING FILE
  762. LT4TYP   DC    X'00'  TYPE OF ESD RECORD GENERATED BY A370.EXE
  763. ESDSD    EQU   1
  764. ESDLD    EQU   2
  765. ESDER    EQU   3
  766. ESDORG   EQU   4
  767. ESDEND   EQU   5
  768. ESDRLD   EQU   6  (SIGN AND LENGTH IN BITS 0-3)
  769. LT4EID   DC    X'00'  ESD NUMBER (1-255) FOR SD, LD, RLD, ORG
  770. ASYMBOL  DC    A(0)   POINTER TO SYMBOL DURING LT4B LOOP
  771. SYMBOL   DC    CL8' ' ESD SYMBOL (SD, LD, AND ER)
  772. SDLNG    DC    A(0)   LENGTH OF SD (SD ONLY)
  773. ADDR     DC    A(0)   RELATIVE ADDRESS (LD, RLD, ORG)
  774. RLDEID   DC    X'00'  EID NUMBER FOR RLD VALUE
  775. RLDLNG   DC    X'00'  RLD LENGTH IN HIGH 4 BITS
  776. TXTREGS  DC    A(TXTBUF,TXTBUF+L'TXTBUF,0)
  777. TXTSAV   DC    A(0)
  778. FMTSAV   DC    A(0)
  779. ENDRCD   DS    0XL80
  780.     DC    X'02',C'END',CL1' '
  781. ENDADDR  DC    XL3'00',CL6' '
  782. ENDEID   DC    XL2'00',CL56' '
  783. ENDSEQ   DC    ZL8'0'
  784. RLDRCD   DS    0XL80
  785.     DC    X'02',C'RLD',CL6' '
  786. RLDCNT   DC    XL2'00',CL4' '
  787. RLDBUF   DC    CL56' '
  788. RLDSEQ   DC    ZL8'0'
  789. ESDRCD   DS    0XL80
  790.     DC    X'02',C'ESD',CL6' '
  791. ESDCNT   DC    XL2'00',CL2' '
  792. ESDEID   DC    XL2'00'     EID OF FIRST ESD OR BLANK FOR LD
  793. ESDBUF   DC    CL56' '
  794. ESDSEQ   DC    ZL8'0'
  795. TXTRCD   DS    0XL80
  796.     DC    X'02',C'TXT',C' '
  797. TXTADDR  DC    XL3'00',CL2' '
  798. TXTCNT   DC    XL2'00',CL2' '
  799. TXTEID   DC    XL2'00'
  800. TXTBUF   DC    CL56' '
  801. TXTSEQ   DC    ZL8'0'
  802. ENDLINE  DS    0CL78
  803.     DC    CL6' ZZZZZ'
  804.     DC    C' END '
  805. ENDDEID  DC    CL2' ',C' '  HEX EID OF CONTROL SECTION WITH RLD
  806. ENDDADDR DC    CL6' ',C' '  HEX ADDRESS
  807.     DC    AL1(CR,LF),C'$'
  808.     DC    (ENDLINE+L'ENDLINE-*)C' '
  809. RLDLINE  DS    0CL78
  810.     DC    CL6' ZZZZZ'
  811.     DC    C' RLD '
  812. RLDDSID  DC    CL2' ',C' '  HEX EID OF CONTROL SECTION WITH RLD
  813. RLDDADDR DC    CL6' ',C' '  HEX ADDRESS
  814. RLDDLNG  DC    CL2' ',C' '  HEX LENGTH
  815. RLDDSGN  DC    CL1' ',C' '  C'+' OR  C'-' SIGN
  816. RLDDEID  DC    CL2' '       HEX EID OF SYMBOL
  817.     DC    AL1(CR,LF),C'$'
  818.     DC    (RLDLINE+L'RLDLINE-*)C' '
  819. ESDLINE  DS    0CL78
  820.     DC    CL6' ZZZZZ'
  821.     DC    C' ESD '
  822. ESDDEID  DC    CL2' ',C' '  DECIMAL EID
  823. ESDDADDR DC    CL6' ',C' '  HEX ADDRESS
  824. ESDDLNG  DC    CL6' ',C' '  HEX SD LENGTH
  825. ESDDTYP  DC    CL2' ',C' '
  826. ESDDSYM  DC    CL8' '
  827.     DC    AL1(CR,LF),C'$'
  828.     DC    (ESDLINE+L'ESDLINE-*)C' '
  829. TXTLINE  DS    0CL78
  830.     DC    CL6' ZZZZZ'
  831.     DC    C' TXT '
  832. TXTDBLK  DS    0CL13        BLANK FOR MULT. LINES
  833. TXTDEID  DC    CL2' ',C' '  DECIMAL EID
  834. TXTDADDR DC    CL6' ',C' '  HEX ADDRESS
  835. TXTDCNT  DC    CL2' ',C' '  HEX COUNT
  836. TXTDHEX  DC    CL32' ',C' *'
  837. TXTDASC  DC    CL16' ',C'*'
  838.     DC    AL1(CR,LF),C'$'
  839.     DC    (TXTLINE+L'TXTLINE-*)C' '
  840. PRTASC   DC    256C'.'
  841.     ORG   PRTASC+C' '
  842.     DC    C' '
  843.     DC    C'ABCDEFGHI'
  844.     ORG   PRTASC+C'A'
  845.     DC    C'ABCDEFGHI'
  846.     ORG   PRTASC+C'J'
  847.     DC    C'JKLMNOPQR'
  848.     ORG   PRTASC+C'S'
  849.     DC    C'STUVWXYZ'
  850.     ORG   PRTASC+C'0'
  851.     DC    C'0123456789'
  852.     ORG   PRTASC+256
  853. ****************************************************************************
  854. *
  855. * IHADCB - I HAD A DCB DSECT FOR PC/370 RELEASE 2.0+ FILE DATA CONTROL BLOCK
  856. *
  857. * FOR MORE INFORMATION SEE SVC.DOC AND DEMO PROGRAM TESTIO.ALC.
  858. *
  859. ****************************************************************************
  860. IHADCB   DSECT
  861. DCBDCB   DS    CL4 CONSTANT EBCDIC C'ADCB' DCB IDENTIFIER
  862. DCBDSN   DS    A   ADDRESS OF UP TO 64 BYTE PATH/FILE SPEC FOLLOWED BY ZERO
  863. DCBFID   DS    H   FILE HANDLE ASSIGNED BY MS-DOS AT OPEN (X'FFFF'DEFAULT)
  864. DCBFLG   DS    X   DATA CONTROL BLOCK FLAGS (ONLY DFTRAN MAY BE SET BY USER)
  865. DFOPEN   EQU   X'80' FILE OPEN
  866. DFUBUF   EQU   X'40' USER DEFINED BLOCK AREA (NO DYNAMIC ALLOC/DEALLOC)
  867. DFOUT    EQU   X'20' OPEN FOR OUTPUT
  868. DFGEOF   EQU   X'10' END OF FILE PENDING ON SHORT BLOCK
  869. DFTRAN   EQU   X'08' TRANSLATE GET/PUT RECORDS FOR ASCII FILE
  870. DFADCB   EQU   X'01' ASSIST DCB - DO NOT TRANSLATE 370 ADDRESSES
  871. DSORG    DS    C   DATA SET ORGANIZATION (R=RANDOM, S=SEQUENTIAL)
  872. MACRF    DS    C   DATA SET ACCESS MODE (R=READ, W=WRITE, G=GET, P=PUT)
  873. RECFM    DS    C   DATA SET RECORD FORMAT (F=FIXED, V=VAR, T=TEXT)
  874. EOR      DS    X   END OF RECORD CODE (DEFAULT IS LINE FEED X'0A')
  875. EOF      DS    X   END OF FILE CODE   (DEFAULT IS CTL-Z X'1A')
  876. LRECL    DS    H   RECORD LENGTH (2<LRECL<64K-16)
  877. BLKSZ    DS    H   BLOCK  LENGTH (2<BLKSZ<64K-16)
  878. EODAD    DS    A   END OF DATA EXIT ADDRESS
  879. SYNAD    DS    A   SYCHRONOUS ERROR EXIT ADDRESS
  880. RCD      DS    A   RECORD AREA ADDRESS FOR GET/PUT
  881. BLK      DS    A   BLOCK  AREA ADDRESS (0 FOR DYNAMICALLY ALLOCATED)
  882. RBA      DS    A   RELATIVE BYTE ADDRESS FOR RANDOM READ/WRITE
  883. REN      DS    A   RENAME ASCIIZ FILE (ONLY USED BY RENAME SVC)
  884. IOCNT    DS    F   BLOCK I/O COUNT SINCE OPEN
  885. PRECL    DS    H   PHYSICAL BLOCK SIZE OF LAST READ/WRITE
  886. *
  887. * RESERVED AREA FOR USE BY PC/370 IOS SUPERVISOR WHILE FILE OPEN
  888. *
  889. DSNSG    DS    XL4 SEGMENT:OFFSET OF DCBDSN PATH/FILE NAME
  890. EODSG    DS    XL4 SEGMENT:OFFSET OF EODAD EXIT
  891. SYNSG    DS    XL4 SEGMENT:OFFSET OF SYNAD EXIT
  892. RCDSG    DS    XL4 SEGMENT:OFFSET OF RECORD AREA FOR GET/PUT
  893. RENSG    DS    XL4 SEGMENT:OFFSET OF RENAME FILE NAME
  894. BLKSG    DS    XL4 SEGMENT:OFFSET OF BLOCK AREA
  895. BLKPTR   DS    XL4 SEGMENT:OFFSET OF CURRENT RECORD IN BLOCK AREA
  896. BLKEOD   DS    XL2 OFFSET OF CURRENT END OF DATA IN BLOCK AREA
  897. BLKEND   DS    XL2 OFFSET OF END OF ALLOCATED BLOCK AREA
  898. WLRECL   DS    H   REVERSED LRECL
  899. WBLKSZ   DS    H   REVERSED BLKSZ
  900. LDCB     EQU   *-IHADCB
  901. *
  902. * END OF DSECT
  903. *
  904. T370   CSECT
  905. UT1DSN   DC    XL64'00'
  906. UT1SFX   DC    C'.OBJ',X'00'
  907. SYSUT1   DC    0F'0',C'ADCB'
  908.     DC    A(UT1DSN)            PATH/FILE NAME IN PARM
  909.     DC    X'FFFF'
  910.     DC    X'00'
  911.     DC    C'SGF'               SEQ. GET FIXED
  912.     DC    X'0A1A'
  913.     DC    H'128'               LRECL
  914.     DC    H'8192'              BLKSZ
  915.     DC    A(EOJ)               EODAD
  916.     DC    A(SYNRTN)            SYNAD
  917.     DC    A(UT1RCD)            RECORD AREA
  918.     DC    XL(SYSUT1+LDCB-*)'00'
  919. UT2DSN   DC    XL64'00'
  920. UT2SFX   DC    C'.370',X'00'
  921. SYSUT2   DC    0F'0',C'ADCB'
  922.     DC    A(UT2DSN)           PATH/FILE NAME IN PARM
  923.     DC    X'FFFF'
  924.     DC    X'00'
  925.     DC    C'SPF'               SEQ. PUT FIXED
  926.     DC    X'0A1A'
  927.     DC    H'80'                LRECL
  928.     DC    H'8192'              BLKSZ
  929.     DC    A(SYNRTN)            EODAD
  930.     DC    A(SYNRTN)            SYNAD
  931.     DC    A(UT2RCD)            RECORD AREA
  932.     DC    XL(SYSUT2+LDCB-*)'00'
  933. PRTDSN   DC    XL64'00'
  934. PRTSFX   DC    C'.HEX',X'00'
  935. SYSPRINT DC    0F'0',C'ADCB'
  936.     DC    A(PRTDSN)            PATH/FILE NAME IN PARM
  937.     DC    X'FFFF'
  938.     DC    AL1(DFTRAN)
  939.     DC    C'SPT'               SEQ. PUT TEXT
  940.     DC    X'0A1A'
  941.     DC    H'133'               LRECL
  942.     DC    H'8192'              BLKSZ
  943.     DC    A(SYNRTN)            EODAD
  944.     DC    A(SYNRTN)            SYNAD
  945.     DC    A(PRTLINE)           RECORD AREA
  946.     DC    XL(SYSPRINT+LDCB-*)'00'
  947. SYNRTN   EQU   *
  948.     LA    R2,=C'I/O ERROR$'
  949.     SVC   WTO
  950.     SVC   TRACE
  951.     DC    C'BUG '
  952.     B     SYNRTN
  953.     END   T370
  954.